home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / debugger.tst < prev    next >
Text File  |  1992-05-19  |  967b  |  72 lines
  1. .( Loading Debugger test...) cr
  2.  
  3. #include debugger.f83
  4.  
  5. debugger 
  6.  
  7.  
  8. .( 1: Define a debuggable tail-recursive function) cr
  9.  
  10. : foo ( n -- )
  11.   ?dup if ." foo " 1- tail-recurse else cr then
  12. ;
  13.  
  14. 12 foo 
  15. trace foo
  16. 12 foo 
  17. .profile
  18.  
  19.  
  20. .( 2: Redefine it as a recursive function) cr
  21.  
  22. : fie ( n -- )
  23.   ?dup if ." fie " 1- recurse else cr then
  24. ;
  25.  
  26. 12 fie 
  27. trace fie
  28. 12 fie 
  29. .profile
  30.  
  31.  
  32. .( 3: Run the break point function) cr
  33.  
  34. break foo
  35.  
  36. 10 foo *return* .s drop cr cr
  37. 10 foo *call* .s cr cr
  38. 10 foo *execute* .s cr
  39.        *profile*
  40. 5      *execute* .s cr
  41.        *profile*
  42.        *return* .s cr
  43. 10 foo *abort* 
  44.  
  45.  
  46. .( 4: Fibonacci number function; recursive and tail recursive) cr
  47.  
  48. : fib ( n -- m)
  49.   dup 1 > if dup 1- recurse swap 2- recurse + then
  50. ;
  51.  
  52. trace fib
  53. 10 fib . cr
  54. .profile
  55.  
  56. : fib-tail ( a b c -- m)
  57.   ?dup if 1- -rot over + swap rot tail-recurse else nip then
  58. ;
  59.  
  60. : fib-iter ( n -- m)
  61.   1 0 rot fib-tail
  62. ;
  63.  
  64. trace fib-tail
  65. trace fib-iter
  66. 10 fib-iter . cr
  67. .profile
  68.  
  69. forth only
  70.  
  71.  
  72.